#light
namespace FSharp.WebTools.ClientLibrary

#nowarn "44" // don't use webbehavior

open System.Collections
open System.Collections.Generic
open FSharp.WebTools
open FSharp.WebTools.Core
open FSharp.WebTools.ClientLibrary
open FSharp.WebTools.ClientLibrary.Internal

(*-----------------------------------------------------------------------------------------------*)
// Mappings for JS objects

[<Mapping("window", MappingScope.Global, MappingType.Inline)>]
type Window = class
  [<Mapping("alert", MappingScope.Member, MappingType.Method)>]
  static member Alert (message:string) = (raise ClientSideScript:unit);
  [<Mapping("confirm", MappingScope.Member, MappingType.Method)>]
  static member Confirm (message:string) = (raise ClientSideScript:bool);
end

(*-----------------------------------------------------------------------------------------------*)
// Several useful client-side objects

/// Client-side class that represents object size (with width and height)
[<ClientSide>]
type Size = class   
  val mutable width : int;
  val mutable height : int;
  
  [<ReflectedDefinition>]
  new() = { width = 0; height = 0; }

  [<ReflectedDefinition>]
  member this.Width
    with get() = this.width; 
    and set(v) = this.width <- v;
  
  [<ReflectedDefinition>]
  member this.Height
    with get() = this.height;
    and set(v) = this.height <- v;
end

/// Client-side class that represents object position (with X and Y coordinage)
[<ClientSide>]
type Position = class   
  val mutable left : int;
  val mutable top : int;
  
  [<ReflectedDefinition>]
  new() = { left = 0; top = 0; }

  [<ReflectedDefinition>]
  member this.Left
    with get() = this.left; 
    and set(v) = this.left <- v;
  
  [<ReflectedDefinition>]
  member this.Top
    with get() = this.top;
    and set(v) = this.top <- v;
end

/// Client-side class that represents rectangle cooridantes
[<ClientSide>]
type Rectangle = class   
  val mutable left : int;
  val mutable top : int;
  val mutable width : int;
  val mutable height : int;
  
  [<ReflectedDefinition>]
  new() = { left = 0; top = 0; width = 0; height = 0; }

  [<ReflectedDefinition>]
  member this.Left
    with get() = this.left; 
    and set(v) = this.left <- v;
  
  [<ReflectedDefinition>]
  member this.Top
    with get() = this.top;
    and set(v) = this.top <- v;
    
  [<ReflectedDefinition>]
  member this.Width
    with get() = this.width; 
    and set(v) = this.width <- v;
  
  [<ReflectedDefinition>]
  member this.Height
    with get() = this.height;
    and set(v) = this.height <- v;    
end

[<ClientSide>]
type Convert = class
  [<ReflectedDefinition>]
  static member ToString (v:'a) = 
    ClientCore.ToString(v)

  [<ReflectedDefinition>]
  static member ToStringDuplex (v:'a) = 
    makeDuplex
      (server { return (box v).ToString() }) 
      (client 
        { return ClientCore.ToString(v) })
end

[<ClientSide>]
type CancelEventArgs = class
  inherit EventArgs
  
  val mutable canceled : bool;
  
  [<ReflectedDefinition>]
  new (b) = { canceled = b; }
  
  [<ReflectedDefinition>]
  member this.Canceled 
    with get() = this.canceled;
    and set(v:bool) = this.canceled <- v;
end

[<ClientSide>]
type MouseEventArgs = class
  inherit CancelEventArgs as base

  val btn : int;
  val pos : Position;

  [<ReflectedDefinition>]
  new (b, p) = { inherit CancelEventArgs(false); btn = b; pos = p; }
  
  [<ReflectedDefinition>]
  member this.Button 
    with get() = this.btn;
  
  [<ReflectedDefinition>]
  member this.Position
    with get() = this.pos;
end  

[<ClientSide>]
type LibXmlHttpRequest = class // todo: namespaces to prevent name clashes // TODO: typed!
  val meth : string
  val url : string
  val received : ClientEvent
  val mutable request : XmlHttpRequestNative option
  
  [<ReflectedDefinition>]
  new (meth:string, url:string) = 
    { meth=meth; url=url; request=None; received = new ClientEvent(); } 

  [<ReflectedDefinition>]
  member this.Send(data:string) =
    let rnd  = new System.Random()
    let s = Convert.ToString(rnd.Next())
    let rnd = "rnd=" + s.Substring(2)
    let rnd = if (this.url.IndexOf("?") = -1) then "?" + rnd else "&" + rnd
    
    let req =
      if (ClientCore.SupportsNativeXmlHttp) then 
        ClientCore.CreateXmlHttpRequestNative();
      else 
        ClientCore.CreateXmlHttpRequestAX();
    this.request <- Some(req)    
    req.ReadyStateChange <- ( fun () -> 
      if (req.ReadyState = 4) then
        if req.Status = 200 then
          this.received.Invoke(this, new EventArgs())
        else
          Window.Alert("Http request failed!\n\nUrl:"+this.url+"\nError code: "+
                       Convert.ToString(req.Status)+"\n\nMore info:" + req.ResponseText) )
    req.Open(this.meth, this.url + rnd, true);
    req.Send(data);

  [<ReflectedDefinition>]
  member this.SendEmpty() = 
    this.Send("");

  [<ReflectedDefinition>]
  member this.Received : ClientEvent = this.received

  [<ReflectedDefinition>]
  member this.ResponseText : string =
    match this.request with 
    | None -> ""
    | Some r -> r.ResponseText
end

[<ClientSide>]  
type Timer = class
  val mutable timerId : int
  val mutable interval : int
  val elapsed : ClientEvent
  
  [<ReflectedDefinition>]
  new () = { timerId = -1; interval = 100; elapsed = new ClientEvent(); }

  [<ReflectedDefinition>]
  member this.Start() =
    this.Stop();
    this.timerId <- ClientCore.SetInterval(ClientCore.CreateGenericHandler(this.elapsed), this.interval);
    
  [<ReflectedDefinition>]    
  member this.Stop() = 
    if (this.timerId <> -1) then
      ClientCore.ClearInterval(this.timerId)
    this.timerId <- -1;      

  [<ReflectedDefinition>]
  member this.Elapsed = this.elapsed;
  
  [<ReflectedDefinition>]
  member this.Interval
    with get() = this.interval
    and  set(v) = this.interval <- v
end;  
  
(*-----------------------------------------------------------------------------------------------*)
    
[<ClientSide>]
type JsonSerializer = 

  [<ReflectedDefinition>]
  static member AppendEscape(sb:System.Text.StringBuilder, s:string) = 
    let ca = s.ToCharArray()
    for n = 0 to s.Length - 1 do
      let c = ca.[n]
      ignore 
        (sb.Append
          (match c with
          | '\\' -> "\\\\"
          | '\"' -> "\\\""
          | '\n' -> "\\n"
          | '\t' -> "\\t"
          | _ -> c.ToString()))
     
  [<ReflectedDefinition>]
  static member SerializeObj (sb:System.Text.StringBuilder, o:obj) =
    let ty = ClientCore.TypeName(o)
    if (false = ClientCore.HasValue(o)) then
      ignore (sb.Append("null"))
    elif (ty = "string") then 
      ignore (sb.Append("\""))
      JsonSerializer.AppendEscape(sb, ClientCore.Cast<string>(o))
      ignore (sb.Append("\""))
    elif (ty = "number" || ty = "boolean") then
      ignore (sb.Append(Convert.ToString(o)))
    else
      let cls  = ClientCore.GetMember(o, "__js_class__")
      let spec = ClientCore.GetMember(o, "__js_special__")
      
      // Special types
      // - array
      // - record
      // - tuple
      // - union
      if (ClientCore.HasValue(spec)) then
        let spec = Convert.ToString(spec)
        let netty = Convert.ToString(ClientCore.GetMember(o, "__net_type__"))
        
        // { "__js_special__": "array", "__net_type__": "...", "members": [ ... ] }
        // { "__js_special__": "record", "__net_type__": "...", "members": [ ... ] }
        // { "__js_special__": "union", "__net_type__": "...", "tag": "...", "members": [ ... ] }
        // { "__js_special__": "tuple", "__net_type__": "...", "members": [ ... ] }
        let members, additional, serfunc = 
          if (spec = "array") then     
            ClientCore.Cast<obj[]>(o), "", (fun sb o ->
              JsonSerializer.SerializeObj(sb, o) )
              
          else if (spec = "record") then
            let res = Array.zero_create 0
            ClientCore.MembersIter(o, fun name ->  
              let tup = (name, ClientCore.GetMember(o, name))
              if (not (name.StartsWith("__"))) then
                ArrayJS.Add(res, ClientCore.Cast<obj>(tup)) )
            res, "", (fun sb o ->
              let (name, value) = ClientCore.Cast<string*obj>(o)
              ignore(sb.Append("{ \"" + name + "\": "))
              JsonSerializer.SerializeObj(sb, value) 
              ignore(sb.Append("}")) )
              
          else if (spec = "union") then
            let du = ClientCore.Cast<DiscriminatedUnion>(o)
            let tag = "\"tag\": \""+du.name+"\", "
            ClientCore.Cast<obj[]>(du.args), tag, (fun sb o ->
              JsonSerializer.SerializeObj(sb, o) )
          
          else if (spec = "tuple") then
            let tup = ClientCore.Cast<Tuple>(o)
            ClientCore.Cast<obj[]>(tup.args), "", (fun sb o ->
              JsonSerializer.SerializeObj(sb, o) )
              
          else failwith "Unknown special type.."
        
        // Write serialized object
        ignore (sb.Append("{ \"__js_special__\": \"" + spec + "\", " + additional))
        ignore (sb.Append("\"__net_type__\": \"" + netty + "\", \"members\": ["))
        Array.iteri (fun i el -> 
          if (i <> 0) then ignore (sb.Append(", "))
          serfunc sb el ) members
        ignore (sb.Append("] }"))

        
      // Class types
      // - all other class types
      elif (ClientCore.HasValue(cls)) then
        // get serializable fields
        let cls = Convert.ToString(cls)
        let flds = ClientCore.Cast<string[]>(ClientCore.GetMember(o, "__mixed_fields__"))
        
        // get & serialize values
        ignore(sb.Append("{ \"__js_class__\": \""+cls+"\", "))
        
        // type arguments?
        let tya = ClientCore.GetMember(o, "__type_args__")
        if (ClientCore.HasValue(tya)) then 
          ignore (sb.Append("\"__type_args__\": "))
          JsonSerializer.SerializeObj(sb, tya)
          ignore (sb.Append(", "))
        
        ignore(sb.Append("\"properties\": {"))
        for i = 0 to flds.Length - 1 do
          let fname = flds.[i]
          if (i <> 0) then ignore(sb.Append(", "))
          ignore(sb.Append("\""+ fname +"\": "))
          JsonSerializer.SerializeObj(sb, ClientCore.GetMember(o, fname))
        ignore(sb.Append("} }"))
      else 
        failwith "Must be either special or a class type!"  
    
  [<ReflectedDefinition>]
  static member Serialize (sb:System.Text.StringBuilder, args:obj[]) =
    ignore(sb.Append("["))
    for i = 0 to args.Length - 1 do
      if (i <> 0) then ignore(sb.Append(", "))
      JsonSerializer.SerializeObj(sb, args.[i])
    done
    ignore(sb.Append(" ]"))
  
  [<ReflectedDefinition>]  
  static member SerializeCallArguments(inst:obj option, args:obj[]) =
    let sb = new System.Text.StringBuilder()
    ignore(sb.Append("{ "))
    let srInst = 
      match inst with 
        | Some i -> 
            let id = ClientCore.Cast<string>(ClientCore.InvokeMember(i, "get_ClientID", [| |]));
            ignore(sb.Append("\"control\": \"" + id + "\", \"instance\": "))
            JsonSerializer.SerializeObj(sb, i)
            ignore(sb.Append(", "))
        | None -> ();            
    ignore(sb.Append("\"arguments\": "))
    JsonSerializer.Serialize(sb, args)
    ignore(sb.Append(" }"))
    sb.ToString()

[<ClientSide>]    
type JsonDeserializer =
  [<ReflectedDefinition>]  
  static member DeserializeServerResponse(jsonObj:obj) =
    let res = ClientCore.GetMember(jsonObj, "result")
    let stateUpd = ClientCore.Cast<obj[]>(ClientCore.GetMember(jsonObj, "state"))
    for i = 0 to stateUpd.Length - 1 do
      let (isProp,updateOn,prop,value) = ClientCore.Cast<bool*string*string*obj>(JsonDeserializer.DeserializeObject(stateUpd.[i]));
      
      let parts = updateOn.Split([| '.' |])
      let updGet = Array.fold_left (fun s part -> s+".FindControl('"+part+"')") "" parts
      let updGet = "thisPage" + updGet.Substring(24)
            
      let objToUpd = ClientCore.Eval(updGet);
      if (ClientCore.HasValue(objToUpd)) then
        if (isProp) then
          ignore (ClientCore.InvokeMember(objToUpd, "set_"+prop, [| value |]))
        else
          ClientCore.SetMember(objToUpd, prop, value);
    JsonDeserializer.DeserializeObject(res);

  [<ReflectedDefinition>]  
  static member DeserializeObject(o:obj) =
    if (ClientCore.TypeName(o) <> "object") then
      o // primitive type parsed by executing JSON
    elif (false = ClientCore.HasValue(o)) then
      ClientCore.Null()
    else
      let cls = ClientCore.GetMember(o, "__js_class__")
      let special = ClientCore.GetMember(o, "__js_special__")
      if (ClientCore.HasValue(cls)) then
      
        // Create class using information from server
        let res = ClientCore.Eval("new "+Convert.ToString(cls)+"();")
        let tya = JsonDeserializer.DeserializeObject(ClientCore.GetMember(o, "__type_args__"));
        ClientCore.SetMember(res, "__type_args__", tya);
        
        let props = ClientCore.GetMember(o, "properties")
        ClientCore.MembersIter(props, (fun name ->
          let oval = JsonDeserializer.DeserializeObject(ClientCore.GetMember(props,name));
          ClientCore.SetMember(res, name, oval); ) );
        res
        
      elif (ClientCore.HasValue(special) && Convert.ToString(special)="array") then
      
        // Array - deserialize array members
        let membs = ClientCore.Cast<obj[]>(ClientCore.GetMember(o, "members"))
        let res = Array.zero_create (membs.Length)
        for i = 0 to membs.Length - 1 do
          res.[i] <- JsonDeserializer.DeserializeObject(membs.[i]);
        ClientCore.Cast<obj>(res);
        
      elif (ClientCore.HasValue(special) && Convert.ToString(special)="record") then
        let rcd = ClientCore.Cast<obj>(ClientCore.GetMember(o, "members"))
        ClientCore.MembersIter(rcd, (fun name ->
          let oval = JsonDeserializer.DeserializeObject(ClientCore.GetMember(rcd, name));
          ClientCore.SetMember(rcd, name, oval); ) );
        ClientCore.InvokeStatic("CreateRecord", [| rcd; ClientCore.GetMember(o, "__net_type__") |])
        
      else
        ClientCore.FailWith("Deserialization failed - object is neither class nor a supported special type!");
  
// The value is defined in "js_core.fs" because it is shared with the 'real' client monad
//   type ClientAsyncMonad<'a> = | Async of (('a -> unit) -> unit)

[<ClientSide>]
type Async = 
  [<ReflectedDefinition>]
  static member Primitive<'a>(func) : ClientAsyncMonad<'a> = 
    AsyncVal func
    
  [<ReflectedDefinition>]
  static member SleepAsync(ms:int) : ClientAsyncMonad<unit> = 
    AsyncVal (fun cont -> 
      let t = new Timer(); 
      t.Interval <- ms;
      t.Elapsed.Add(fun (sender, e) -> 
        t.Stop();
        cont ())
      t.Start(); )

  [<ReflectedDefinition>]
  static member HttpCall<'a> (req:LibXmlHttpRequest, inst:obj option, args:obj[]) : ClientAsyncMonad<'a> = 
    AsyncVal (fun (cont:'a -> unit) -> 
      req.Received.Add(fun (sender, e) ->
        //Window.Alert(req.ResponseText);
        let tmpVar = ClientCore.Cast<'a>(JsonDeserializer.DeserializeServerResponse(ClientCore.Eval("var _tmp=" + req.ResponseText + "; _tmp")))
        cont tmpVar)
      let srSend = JsonSerializer.SerializeCallArguments(inst, args)
      //Window.Alert(srSend);
      req.Send(srSend); )


[<ClientSide>]
type AsyncMonad = class
  [<ReflectedDefinition>]
  static member Zero () =
    AsyncVal (fun cont -> cont ())

  [<ReflectedDefinition>]
  static member Result (value:'a) =
    AsyncVal (fun cont -> cont value)
  
  [<ReflectedDefinition>]
  static member Bind<'a,'b> (monad:ClientAsyncMonad<'a>, p2:('a -> ClientAsyncMonad<'b>)) : ClientAsyncMonad<'b> = 
    let (AsyncVal f) = monad
    AsyncVal (fun cont -> f (fun a -> let (AsyncVal g) = p2 a in g cont))

  [<ReflectedDefinition>]
  static member Let<'a,'b> (f:'a, p2:('a -> ClientAsyncMonad<'b>)) : ClientAsyncMonad<'b> = 
    AsyncVal (fun cont -> let (AsyncVal g) = p2 f in g cont) 
    
  [<ReflectedDefinition>]
  static member Run (value:ClientAsyncMonad<unit>) : unit =
    let (AsyncVal f) = value
    f (fun () -> ());
end

(*-----------------------------------------------------------------------------------------------*)

type IClientPage = 
  interface
  end

type IClientControl = 
  interface
  end

[<NativeClientSide("Dom.Element")>]
type IElement = interface
  inherit IClientControl
  
  abstract ID : string with get
  abstract ClientID : string with get
  
  abstract Size : Size with set 

  abstract Position : Position with get
  abstract Position : Position with set

(* WORKAROUND: for the 'convMethodRef' bug in F# 1.9.3          
    - renamed from 'Visible' *)
  abstract ClientVisible : bool with get
  abstract ClientVisible : bool with set

  abstract AttachHandler : string * (unit -> unit) -> unit
  
  abstract AddCssClass : string -> unit
  abstract RemoveCssClass : string -> unit
  
  abstract AppendChild : IElement -> unit  
  abstract GetChild : string -> IElement option 
  abstract SetupDragDrop : IElement-> unit
  
  abstract InnerHtml : string with get
  abstract InnerHtml : string with set

  abstract InnerText : string with get
  abstract InnerText : string with set

  abstract Value : string with get
  abstract Value : string with set
  
  abstract ClientClick : ClientEvent
  abstract ClientMouseUp : ClientEvent
  abstract ClientMouseDown : ClientEvent
  abstract ClientMouseMove : ClientEvent
  abstract ClientSelectStart : ClientEvent
end

(*-----------------------------------------------------------------------------------------------*)

[<ClientSide>]
type Document = 
  [<Mapping("CreateAndWrapElement", MappingScope.Global, MappingType.Method)>]
  static member CreateElement(tag:string) : IElement = (raise ClientSideScript)
